﻿Imports System.Reflection
Imports System.Globalization

Public NotInheritable Class Serializer


    Public Shared Function Serialize(ByVal settings As Settings) As XElement

        Dim el = <Settings id=<%= "hoge" %>></Settings>

        For Each i As String In settings.Keys
            Dim value = settings(i)
            Dim element = CreateElement(i, value)
            If element Is Nothing Then
                Continue For
            End If
            el.Add(element)
        Next

        Return el
    End Function

    Public Shared Function Deserialize(ByVal element As XElement) As Settings

        Dim s = New Settings

        'For Each e In element...<Settings>
        For Each item In element.Elements

            Try
                Dim key = item.Name.LocalName
                s.Add(key, CreateValue(item))
            Catch formatEx As FormatException
                ' Ignore
            End Try

        Next
        'Next

        Return s

    End Function

    Private Shared Function CreateValue(ByVal element As XElement) As Object

        Dim value As Object = Nothing

        Select Case element.@type

            Case "IDictionary"
                Dim dic = New Dictionary(Of Object, Object)
                For Each pair In element.Elements
                    dic.Add(CreateValue(pair.Element("key")), CreateValue(pair.Element("value")))
                Next
                value = dic

            Case "IList"
                Dim list = New List(Of Object)
                For Each e In element.Elements
                    list.Add(CreateValue(e))
                Next
                value = list

            Case "String"
                value = element.Value

            Case "Uri"
                Dim u As Uri = Nothing
                If Uri.TryCreate(element.Value, UriKind.RelativeOrAbsolute, u) Then
                    value = u
                End If

            Case Else

                Dim t = Type.GetType("System." & element.@type)
                If t Is Nothing Then
                    ' Not System type
                    value = CreateValue(Nothing, element)
                    Exit Select
                End If

                Dim objs = New Object() {element.Value, Nothing}
                Dim mods = New ParameterModifier(2)
                mods(1) = True

                Dim result = t.InvokeMember("TryParse", _
                                            BindingFlags.InvokeMethod, _
                                            Nothing, _
                                            t, _
                                            objs, _
                                            New ParameterModifier() {mods}, _
                                            CultureInfo.InvariantCulture, _
                                            Nothing)
                If Convert.ToBoolean(result) = True Then
                    value = objs(1)
                End If

        End Select

        Return value
    End Function

    Private Shared Function CreateValue(ByVal target As Object, ByVal element As XElement) As Object
        Dim value As Object = Nothing
        Dim instance As Object
        Dim t As Type

        If target Is Nothing Then
            t = Type.GetType(element.@type)
            If t Is Nothing Then
                Return Nothing
            End If
            instance = Activator.CreateInstance(t)
        Else
            instance = target
            t = instance.GetType
        End If

        If instance.GetType.BaseType Is GetType([Enum]) Then
            Try
                value = [Enum].Parse(t, element.Value)
            Catch ex As Exception
                ' Ignore
            End Try
            Return value
        End If

        For Each p In instance.GetType.GetProperties
            If Not p.CanRead OrElse p.GetIndexParameters.Length > 0 Then
                Continue For
            End If

            Dim attrs = p.GetCustomAttributes(GetType(Xml.Serialization.XmlIgnoreAttribute), True)
            If attrs.Length > 0 Then
                Continue For
            End If

            Dim e = element.Element(p.Name)
            If e Is Nothing Then
                Continue For
            End If

            Dim childInstance = p.GetValue(instance, Nothing)
            If childInstance Is Nothing AndAlso Not p.CanWrite Then
                ' コンストラクタでインスタンス化されない, 書き込み不可の場合
                Continue For
            End If

            If e.@type = "IList" Then
                Dim values = CreateValue(e)
                Dim list = DirectCast(childInstance, IList)
                For Each item In DirectCast(values, IList)
                    list.Add(item)
                Next
                Continue For

            ElseIf e.@type = "IDictionary" Then
                Dim values = CreateValue(e)
                Dim dstDictionary = DirectCast(childInstance, IDictionary)
                Dim srcDictionary = DirectCast(values, IDictionary)
                For Each key In srcDictionary.Keys
                    If dstDictionary.Contains(key) Then
                        Continue For
                    End If
                    dstDictionary.Add(key, srcDictionary(key))
                Next
            End If

            If Not p.CanWrite Then
                CreateValue(childInstance, e)
                Continue For
            End If

            p.SetValue(instance, CreateValue(e), BindingFlags.SetProperty, Nothing, Nothing, CultureInfo.InvariantCulture)

        Next
        Return instance

    End Function

    Private Shared Function CreateElement(ByVal name As String, ByVal value As Object) As XElement
        If value Is Nothing Then
            Return Nothing
        End If

        Dim e = <<%= name %>></>
        Dim t = value.GetType
        If TypeOf value Is IDictionary Then

            e.@type = "IDictionary"

            Dim dic = DirectCast(value, IDictionary)
            For Each k In dic.Keys

                Dim pair = <pair></pair>
                pair.Add(CreateElement("key", k))
                pair.Add(CreateElement("value", dic(k)))

                e.Add(pair)
            Next

        ElseIf TypeOf value Is IList Then

            e.@type = "IList"

            For Each o In DirectCast(value, IList)
                e.Add(CreateElement("value", o))
            Next

        ElseIf TypeOf value Is Uri Then
            e.@type = "Uri"
            e.Value = DirectCast(value, Uri).ToString

        ElseIf TypeOf value Is [Enum] Then
            e.@type = value.GetType.FullName
            e.Value = Convert.ToString(value, CultureInfo.InvariantCulture)

        ElseIf Not t.IsClass OrElse t Is GetType(String) Then
            e.@type = t.Name
            e.Value = Convert.ToString(value, CultureInfo.InvariantCulture)

        ElseIf t.IsClass Then

            e.@type = t.FullName

            For Each p In t.GetProperties
                If Not p.CanRead OrElse p.GetIndexParameters.Length > 0 Then
                    Continue For
                End If

                Dim attrs = p.GetCustomAttributes(GetType(Xml.Serialization.XmlIgnoreAttribute), True)
                If attrs.Length > 0 Then
                    Continue For
                End If

                If Not p.CanWrite AndAlso (Not p.PropertyType.IsClass OrElse p.PropertyType Is GetType(String)) Then
                    Continue For
                End If

                Dim v = p.GetValue(value, Nothing)

                If TypeOf v Is IList OrElse _
                   TypeOf v Is IDictionary Then
                    e.Add(CreateElement(p.Name, v))
                    Continue For
                End If

                e.Add(CreateElement(p.Name, v))
            Next

        End If

        Return e
    End Function


End Class
